home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / gausselm.src < prev    next >
Text File  |  1992-01-11  |  2KB  |  127 lines
  1. %%HP: T(3)A(R)F(.);
  2. @ GAUSSELM by Robert Brunner
  3. DIR
  4.   QR
  5.     \<< TRN CONJ DCMP
  6. OVER DUP 2 \->LIST 0
  7. CON { } \-> a n m r q
  8.       \<< a 1 GET DUP
  9. DUP ABS / DUP ROT
  10. DOT 'r' { 1 1 } ROT
  11. PUT 'q' SWAP STO+ 2
  12. n
  13.         FOR i a i
  14. GET DUP \-> ai
  15.           \<< 1 i 1 -
  16.             FOR j
  17. DUP q j GET DUP ai
  18. DOT 'r' { j i } ROT
  19. PUT DUP ROT DOT * -
  20.             NEXT
  21. DUP ABS / DUP ai
  22. DOT 'r' { i i } ROT
  23. PUT 'q' SWAP STO+
  24.           \>>
  25.         NEXT q RCMP
  26. TRN CONJ r
  27.       \>>
  28.     \>>
  29.   LU
  30.     \<< DCMP OVER IDN
  31. DUP 0 CON DCMP
  32. DROP2 SWAP DCMP
  33. DROP2 1 DUP DUP
  34. RCLF \-> a m n l p pr
  35. pc sr flg
  36.       \<<
  37.         WHILE pr m
  38. < pc n \<= AND
  39.         REPEAT 1 CF
  40.           WHILE 1
  41. FC? pc n \<= AND
  42.           REPEAT pr
  43. 'sr' STO
  44.             WHILE 1
  45. FC? sr m \<= AND
  46.             REPEAT
  47.               IF a
  48. sr GET pc GET
  49.               THEN
  50. 1 SF
  51.               ELSE
  52. 'sr' INCR DROP
  53.               END
  54.             END
  55.             IF 1
  56. FC?
  57.             THEN
  58. 'pc' INCR DROP
  59.             END
  60.           END
  61.           IF 1 FS?
  62.           THEN
  63.             IF pr
  64. sr \=/
  65.             THEN
  66. 'p' pr sr SWRW 'l'
  67. pr sr SWRW 'a' pr
  68. sr SWRW
  69.             END a
  70. pr GET DUP pc GET \->
  71. pivr piv
  72.             \<< pr 1
  73. + m
  74.               FOR i
  75. a i GET DUP pc GET
  76. piv / DUP l i GET
  77. pr ROT PUT 'l' i
  78. ROT PUT pivr * -
  79. 'a' i ROT PUT
  80.               NEXT
  81.             \>>
  82.           END 'pr'
  83. INCR 'pc' INCR
  84. DROP2
  85.         END p RCMP
  86. l RCMP m IDN + a
  87. RCMP flg STOF
  88.       \>>
  89.     \>>
  90.   DCMP
  91.     \<< OBJ\-> OBJ\->
  92. DROP DUP2 * OVER 1
  93. - \-> m n mn n1
  94.       \<< 1 m
  95.         FOR i n
  96. \->ARRY mn n1 i * -
  97. ROLLD
  98.         NEXT m
  99. \->LIST m n
  100.       \>>
  101.     \>>
  102.   RCMP
  103.     \<< OBJ\-> OVER
  104. SIZE OBJ\-> DROP OVER
  105. \-> m n st
  106.       \<< 1 m
  107.         START OBJ\->
  108. DROP 'st' n 1 -
  109. STO+ st ROLL
  110.         NEXT 1 n 1
  111. -
  112.         START st
  113. ROLL
  114.         NEXT { m n
  115. } \->ARRY
  116.       \>>
  117.     \>>
  118.   SWRW
  119.     \<< \-> i j
  120.       \<< DUP i GET
  121. SWAP DUP DUP j GET
  122. i SWAP PUT j ROT
  123. PUT
  124.       \>>
  125.     \>>
  126. END
  127.